*****************************************************************************
***                                                                       ***
***  dacLIB - Biblioteca de Rotinas Basicas da WennySoft                  ***
***  Author      : Luis Lin                                               ***
***  Last Update : 16/MAI/2009                                            ***
***                                                                       ***
*****************************************************************************
#include "Inkey.ch"
#Include "box.ch"
#define color1 "GR+/B,W+/G,B,,B/BG"
#define color2 "w+/r,,,w/b"
Function dacUTIL()
local guru, senha1, senha2, senha3, senha4, senha5
local OldCursor
   OldCursor := SetCursor()
   guru = space(15)
   set cursor off
   senha1 = inkey(0)
   if  senha1 = 103 .or. senha1 = 71
       senha2 = inkey(0)
       if  senha2 = 117 .or. senha2 = 85
           senha3 = inkey(0)
           if  senha3 = 114 .or. senha3 = 82
               senha4 = inkey(0)
               if  senha4 = 117 .or. senha4 = 85
                   senha5 = inkey(0)
                   set cursor on
                   dacinstall(senha5)
               endif
           endif
       endif
   endif
   SetCursor(OldCursor)
return NIL

Function dacinstall(senha5)
local linx,liny,colx,coly,OldCursor,OldColor,sTela
local GetList := {}
LOCAL ws_dacnom
LOCAL ws_dacred
LOCAL ws_dactel
LOCAL ws_client
LOCAL ws_clired
LOCAL ws_datexp
LOCAL ws_system
LOCAL ws_reindx
LOCAL ws_nserie
LOCAL ws_codven
LOCAL ws_pedido
LOCAL ws_cidade
LOCAL ws_pedini
LOCAL ws_pedfim

sTela := SaveScreen(4,0,23,79)
OldCursor := SetCursor()
OldColor := SetColor()
linx=7
colx=02
liny=23
coly=77
set color to "BG/N,N/W,,,N/W"
@ linx,colx,liny,coly box B_DOUBLE+chr(177)
set color to
*@ linx+3,colx+15 clear to linx+15,58
@ linx+1 ,colx+2  say "            : "
@ linx+3 ,colx+2  say "Reduzido    : "
@ linx+3 ,colx+30 say " Telefone : "
@ linx+5 ,colx+2  say "Cliente     : "
@ linx+7 ,colx+2  say "Reduzido    : "
@ linx+9 ,colx+2  say "Data expir  : "
@ linx+11,colx+2  say "Flg System  : "
@ linx+13,colx+2  say "Flg Reindex : "
@ linx+15,colx+2  say "Numer.Serie : "
@ linx+7 ,colx+40  say "Cod.Repres. : "
@ linx+9 ,colx+40  say "N.Ped.Atual : "
@ linx+11,colx+40  say "Cidade      : "
@ linx+13,colx+40  say "Ped.Inicial : "
@ linx+15,colx+40  say "Ped.Final   : "

do  while .t.
    ws_dacnom = space(42)
    ws_dacred = space(9)
    ws_dacred = ws_dacnom
    ws_dactel = space(14)
    ws_dactel = "(011) 889-8699"
    ws_client = space(40)
    ws_client = ws_dacnom
    ws_clired = space(12)
    ws_clired = ws_clired
    ws_datexp = date() + 366
    ws_system = space(1)
    ws_reindx = space(1)
    ws_nserie = 0

    sele 99
    go top
    @ linx+1 ,colx+2  say dac_dacred

    ws_dacnom = dac_dacnom
    ws_dacred = dac_dacred
    ws_dactel = dac_dactel
    ws_client = dac_client
    ws_clired = dac_clired
    ws_datexp = dac_datexp
    ws_datexp = date() + 366
    ws_system = dac_system
    ws_reindx = dac_reindx
    ws_nserie = dac_nserie
    ws_codven = dac_codven
    ws_pedini = dac_pedini
    ws_pedfim = dac_pedfim
    ws_pedido = dac_pedido
    ws_cidade = dac_cidade

    @ linx+1 ,colx+16 say ws_dacnom
    @ linx+3 ,colx+16 say ws_dacred
    @ linx+3 ,colx+42 say ws_dactel
    @ linx+5 ,colx+16 say ws_client
    @ linx+7 ,colx+16 say ws_clired
    @ linx+9 ,colx+16 say ws_datexp
    @ linx+11,colx+16 say ws_system
    @ linx+13,colx+16 say ws_reindx
    @ linx+15,colx+16 say ws_nserie

    @ linx+7 ,colx+54 say ws_codven
    @ linx+9 ,colx+54 say ws_pedido
    @ linx+11,colx+54 say ws_cidade
    @ linx+13,colx+54 say ws_pedini
    @ linx+15,colx+54 say ws_pedfim

    if  senha5 = 64
        @ linx+1 ,colx+16 get ws_dacnom
        @ linx+3 ,colx+16 get ws_dacred
        @ linx+3 ,colx+42 get ws_dactel
    end if
    @ linx+5 ,colx+16 get ws_client
    @ linx+7 ,colx+16 get ws_clired
    @ linx+9 ,colx+16 get ws_datexp
    @ linx+11,colx+16 get ws_system
    @ linx+13,colx+16 get ws_reindx
    @ linx+7 ,colx+54 get ws_codven
    @ linx+9 ,colx+54 get ws_pedido
    @ linx+11,colx+54 get ws_cidade
    @ linx+13,colx+54 get ws_pedini
    @ linx+15,colx+54 get ws_pedfim
    read
    if  lastkey() = K_ESC
        exit
    endif
    ws_nserie := calc_serie_number(ws_dacnom,ws_dacred,;
                                   ws_dactel,ws_client,ws_clired,ws_datexp)
    @ linx+15,colx+16 say ws_nserie pict "999999999"
    inkey(0)
    repl dac_dacnom  with ws_dacnom
    repl dac_dacred  with ws_dacred
    repl dac_dactel  with ws_dactel
    repl dac_client  with ws_client
    repl dac_clired  with ws_clired
    repl dac_datexp  with ws_datexp
    repl dac_system  with ws_system
    repl dac_reindx  with ws_reindx
    repl dac_nserie  with ws_nserie
    repl dac_codven  with ws_codven
    repl dac_pedido  with ws_pedido
    repl dac_cidade  with ws_cidade
    repl dac_pedini  with ws_pedini
    repl dac_pedfim  with ws_pedfim
    exit
enddo
SetCursor(OldCursor)
SetColor(OldColor)
RestScreen(4,0,23,79,sTela)
return nil

*** Procedimento que emite a mensagem de direitos autorais

Function dac_quit()
@ 21,12 say "***    Copia de Software " + transform(dacctrl->dac_dacred,"@!") +;
                               " nao autorizada    ***"
@ 22,12 say space(7) + "Para regularizacao contate: " + dacctrl->dac_dactel + space(6)
set cursor off
disp_mens({transform(dacctrl->dac_dacnom,"@!")},.t.)
@ 0,0 clear
set cursor on
quit
return NIL

*** Funcao que calcula o numero da serie do software

Function calc_serie_number(ws_dacnom,ws_dacred,ws_dactel,ws_client,ws_clired,ws_datexp)
local n1,n2,n3,n4,n5,num_serie,i
n1 = 0
n2 = 0
n3 = 0
n4 = 0
n5 = 0
for i=0 to 13
n1 = n1 + bin2l(substr(ws_dacnom,i*3+1,3))
next
for i=0 to  2
n2 = n2 + bin2l(substr(ws_dacred,i*3+1,3))
next
for i=0 to  4
n5 = n5 + bin2l(substr(ws_dactel,i*3+1,3))
next
for i=0 to  9
n3 = n3 + bin2l(substr(ws_client,i*4+1,4))
next
for i=0 to  3
n4 = n4 + bin2l(substr(ws_clired,i*3+1,3))
next
for i=0 to  1
n5 = n5 + bin2l(substr(dtoc(ws_datexp),i*4+1,4))
next
num_serie = (n1+n3)*7+(n2+n4)*5+(n1+n2+n5)*3+(n2+n4+n5)*2
num_serie = num_serie %  1000000000
return num_serie

FUNCTION HelpLookUp(cProc, nLine, cVar)
LOCAL OldSelect
  OldSelect := SELECT()
  Select HELP
  go top
  IF  cProc == NIL
      SEEK "BROWSE"
  ELSE
      SEEK READVAR()
  END
  if  ! found()
      Disp_mens({"Help NAO DISPONIVEL..."},.t.)
      if  lastkey() = K_SH_F10
          APPEND BLANK
          DisplayHelp(HELP->HP_XTXTHLP,.T.)
      end
  else
      DisplayHelp(HELP->HP_XTXTHLP,.F.)
  end
  SELECT(OldSelect)
RETURN NIL

FUNCTION DisplayHelp(Topico,lEdit)
LOCAL cScreen := SAVESCREEN(7,9,17,71)
LOCAL lCursor, xCor
lCursor := SetCursor()
xCor := SetColor()
SET COLOR TO B/BG
SET CURSOR OFF
@ 7,9 CLEAR TO 17, 71
@ 7,9 TO 17,71 DOUBLE
SET COLOR TO W/N
@ 7,37 say " HELP "
SET COLOR TO B/BG
if  lEdit
    replace HELP->HP_XTXTHLP with MEMOEDIT(Topico, 8, 10, 16, 69)
else
    MEMOEDIT(Topico, 8, 10, 16, 69, .F.)
end
SetColor(xCor)
RESTSCREEN(7,9,17,71,cScreen)
SetCursor(lCursor)
RETURN NIL

*** Procedimento que Solicita a Resposta de usario

Function Disp_sn(msg)
LOCAL cColor, lCursor, xTela, i,nSpace, lResp, xResp, nKey
LOCAL TamMsg
TamMsg  := Len(msg)
cColor  := SetColor()
lCursor := SetCursor()
xTela   := SaveScreen(10,18,15 + TamMsg,61)
SetColor(color2)
set cursor off
@ 10,18,15 + TamMsg,61 BOX B_DOUBLE
@ 11,19 clear to 14 + TamMsg, 60
@ 13 + TamMsg,35 say "Sim"
@ 13 + TamMsg,42 say "Nao"
xResp := SaveScreen(12 + TamMsg,30,14 + TamMsg,50)
for i = 1 to TamMsg
    nSpace := (40 - Len(msg[i])) / 2
    @ 11+i, 20+nSpace say msg[i] pict "@s40"
next
lResp := .t.
nKey  := 0
@ 12 + TamMsg, 33, 14 + TamMsg, 39 BOX B_SINGLE

DO WHILE nKey # K_ENTER .AND. nKey # K_ESC
   nKey := inkey(0)
   if nKey # K_ENTER .AND. nKey # K_ESC
      lResp := ! lResp
      RestScreen(12 + TamMsg,30,14 + TamMsg,50, xResp)
      if lResp
         @ 12 + TamMsg, 33, 14 + TamMsg, 39 BOX B_SINGLE
      else
         @ 12 + TamMsg, 40, 14 + TamMsg, 46 BOX B_SINGLE
      end
   end
   if  nKey == K_ESC
       lResp := .f.
   end
ENDDO

RestScreen(10,18,15 + TamMsg,61,xTela)
SetCursor(lCursor)
SetColor(cColor)
return lResp

*** Procedimento que executa a exibicao de mensagens do Sistema

procedure Disp_mens(msg,lEnter)
LOCAL cColor, lCursor, xTela, i,nSpace
LOCAL TamMsg
TamMsg  := Len(msg)
cColor  := SetColor()
lCursor := SetCursor()
xTela   := SaveScreen(10,18,13 + TamMsg,61)
SetColor(color2)
set cursor off
   @ 10,18,13 + TamMsg,61 BOX B_DOUBLE

   @ 11,19 clear to 12 + TamMsg, 60
     for i = 1 to TamMsg
     nSpace := (40 - Len(msg[i])) / 2
   @ 11+i, 21+nSpace say msg[i] pict "@s40"
     next
   if  lEnter
     inkey(0)
     RestScreen(10,18,13 + TamMsg,61,xTela)
   end
SetCursor(lCursor)
SetColor(cColor)
return

*** Procedimento que gerencia a impressao dos Relatorios do sistema
*** num formulario de 80 colunas

function print80(p80_opcao, P80_titulo, P80_cabec)
local controle
do case
   case p80_opcao = 'O'
        p80_opcao = 'I'
        controle = .t.
        do while controle
           if isprinter()
              Disp_mens({"Aguarde...Imprimindo o Relatorio"},.f.)
              set printer to
              set device to print
              set console off
              set print on
              set cursor off
              M->pagina = 0
              M->linha  = 5
              controle = .f.
           else
              disp_mens({"Impressora desligada"},.t.)
              if  lastkey() = K_ESC
                  set color to
                  set cursor on
                  return NIL
              endif
           endif
        enddo
   case p80_opcao = 'C'
        prt80_rod()
        eject
        set cursor on
        set device to screen
        set console on
        set print off
        set printer to
   otherwise
        M->linha ++
        if  M->linha = 6 .or. M->linha >= 61
            if  M->linha >= 61
                prt80_rod()
            endif
            M->pagina ++
            @ 0,0   say chr(15)
            @ 1,0   say chr(14)+ltrim(dacCTRL->dac_client)
            @ 1,60  say chr(20)+ '  FOLHA : ' + str(M->pagina,3)
            @ 2,0   say chr(14)+P80_titulo
            @ 3,0   say replic('-',132)
            @ 4,0   say P80_cabec
            if P80_cabec != ''
               @ 5,0   say replic('-',132)
            end
        endif
   endcase
return NIL

*** Procedimento que faz a impressao dos rodapes
*** dos Relatorios do sistema

Function prt80_rod()
   @ 61,0   say chr(15)
   @ 61,0   say replic('-',132)
   @ 62,0   say dacCTRL->dac_dacnom
   @ 62,109 say 'Em ' + dtoc(date()) + ' as ' + substr(time(),1,5) + " hs"
   @ 62,112 say dtoc(date()) + ' as ' + substr(time(),1,5) + " hs"
   M->linha = 6
   @ 63,00 say chr(18)
return NIL



function mess_get(cParm)
  cOldColor := setcolor("bg+/r")
  @ 24,00 say space(80)
  @ 24,centra(cParm) say cParm
  setcolor(cOldColor)
return .t.



function udf(cParm)
  cOldColor := setcolor("bg+/r")
  @ 24,00 say space(80) COLOR "BG+/R"
  @ 24,centra(cParm) say cParm  COLOR "BG+/R"
  setcolor(cOldColor)
return ""

FUNCTION CENTRA(TEXTO)
RETURN (80-LEN(TEXTO))/2




FUNCTION DBLOCKREC() // Esta funcao e definida pelo usuario, nao e nativa do Clipper!
DO WHILE !RLOCK()
ENDDO
RETURN




